perm filename CLUST.SAI[X,ALS] blob
sn#105700 filedate 1974-06-12 generic text, type T, neo UTF8
00010 BEGIN "CLUSTER"
00020 DEFINE ⊂="COMMENT"; ⊂ 10/7/73;
00030 ⊂ This program has been simplified for use in getting
00040 histographs;
00050
00060 DEFINE NU="'250000000000";
00070 REQUIRE "BLOCKS.HDR[4,ALS]" SOURCE_FILE;
00080 ⊂ EXTERNAL STRING PROCEDURE INCHWL; ⊂ Temp ⊂ to test june 12,1974;
00090 DEFINE BUFSIZ="1024",CNTSIZ="100";
00100 STRING TFILEI,FILEI,OPT1,OPT2,MESS,SPONAM;
00110 INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00120 INTEGER ARRAY LFILE[0:'177];
00130 INTEGER CHAN1,CHAN4,CHAN6,EOF,IEOF,FILEC,CHAN2;
00140 INTEGER BPT,SEGCNT,SEGTOT,H,I,J,K,L,Q,ZZ;
00150 INTERNAL INTEGER M,N,P,RATE,FLAG,SEGC,INTOT,HINT,TFLAG,UPCNT;
00160 LABEL STRT,LABELA,LABELB,ZZZZ,FINISH;
00170 INTEGER ARRAY COUNT[0:63,0:63];
00180 PRELOAD_WITH '1000000000,'1000000,'1000,1;
00190 INTEGER ARRAY MS,NS,NUMLS,NUML,BIT[0:3];
00200 INTEGER ARRAY GVAL,GFLAG[0:3];
00210 INTEGER ARRAY IX[0:1];
00220 STRING ARRAY IN,GATENA[0:3];
00230 INTEGER M1,M2,M3,M4,N1,N2,N3,N4,POINTL;
00240 INTEGER ARRAY SUMM,SUMN[0:63,0:3];
00250 INTEGER ARRAY MTOT,NTOT[0:3];
00260 INTEGER BIN,TOT,TOTD;
00270 INTEGER HINCNT,HCOUNT,HINDEX,PREHINT;
00280
00290 PRELOAD_WITH
00300 '777777,
00310 '777000777,
00320 '777777000,
00330 '777000000777,
00340 '777000777000,
00350 '777777000000,
00360 '777,
00370 '777000,
00380 '777000000,
00390 '777000000000,
00400 0;
00410 INTEGER ARRAY MASK[0:10];
00420
00430 PRELOAD_WITH
00440 '21,'22,'23,'24,'25,'26,'41,'42,'43,'44,6;
00450 INTEGER ARRAY SYMBOL[0:10];
00460
00470 DEFINE FF="'14";
00475 DEFINE CRLF0="CR&'177&'21";
00480
00490 INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
00500 BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
00510 BOOLEAN NF;
00520 LOOKUP(CHAN,FILENAME,NF);
00530 WHILE NF DO
00540 BEGIN
00550 OUTSTR(CR&LF&"Can't find "&FILENAME&". try [1,VIN], File=");
00560 FILENAME ← INCHWL ;
00570 LOOKUP(CHAN,FILENAME,NF)
00580 END;
00590 END "LOOKIN";
00600
00610 INTEGER PROCEDURE HEADER;
00620 BEGIN "HEADER"
00630 INTEGER I,J,K,H1;
00640 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; HINCNT←HINCNT+1;
00650 RETURN(PREHINT) END ELSE WHILE HCOUNT=0 DO BEGIN "XX"
00660 I←LFILE[HINDEX]; K←LDB(POINT(14,I,27)); J←SEGC-K;
00670 IF I=0 THEN BEGIN PREHINT←NU; HCOUNT←999; RETURN(PREHINT) END;
00680 IF J ≥ 0 THEN BEGIN "LATCH"
00690 H1←I LAND '777760000000;
00700
00710 IF H1≠0 THEN BEGIN
00720 PREHINT←H1; HCOUNT←LDB(POINT(8,I,35));
00730 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; HINCNT←HINCNT+1;
00740 RETURN(PREHINT); DONE END
00750 ELSE BEGIN PREHINT←NU; HCOUNT←LDB(POINT(8,I,35));
00760 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE; END;
00770 END "LATCH";
00780 PREHINT←NU; RETURN(PREHINT); END "XX";
00790 END "HEADER";
00800
00810
00820 PROCEDURE TOP;
00830 BEGIN
00840 SETFORMAT(2,0); OUT(CHAN2,CRLF&TB&" ");
00850 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
00860 IF (J MOD 10)=0 THEN OUT(CHAN2,CVS(J)[1 TO 1]) ELSE
00870 OUT(CHAN2," "); IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
00880 OUT(CHAN2,CRLF&"IN1\IN2"&TB&" ");
00890 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
00900 OUT(CHAN2,CVS(J)[2 TO 2]); IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
00910 OUT(CHAN2,CRLF&TB&"+");
00920 FOR J←0 STEP 1 UNTIL 63 DO BEGIN OUT(CHAN2,"-");
00930 IF J≠63 THEN IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
00940
00950 END;
00960
00970 PROCEDURE BOTTOM;
00980 BEGIN
00990 OUT(CHAN2,TB&"+");
01000 FOR J←0 STEP 1 UNTIL 63 DO BEGIN OUT(CHAN2,"-");
01010 IF J≠63 THEN IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
01020 OUT(CHAN2,"+"&CRLF0);
01030 END;
01040
00010 FILEI←"SEG1.T01";UPCNT←3;OPT1←"N";FILEC←0;
00020 CHAN4←4;CHAN6←6; CHAN2←2;CHAN1←1;
00030 OUTSTR("This program produces cluster diagrams of data on T0 files"&crlf);
00040 BIN←16;
00050 HEADIN;
00060 OUTSTR("Four phones or features may be specified"&CRLF);
00070 FOR L←0 STEP 1 UNTIL 3 DO BEGIN "PHIN"
00080 WHILE TRUE DO
00090 IF (GATENA[L]←STRIN("Type Ph or Feature )= "))="" then
00100 BEGIN GFLAG[L]←0; GATENA[L]←"Empty"; DONE END ELSE BEGIN
00110 GFLAG[L]←1; I←CVASC(GATENA[L]);
00120 FOR J←0 STEP 1 UNTIL 63 DO IF PHLIST[J]=I THEN DONE;
00130 IF J≤63 THEN BEGIN GVAL[L]←PHLIST[J]; DONE END ELSE BEGIN
00140 FOR J←0 STEP 1 UNTIL 35 DO IF FLIST[J]=I THEN DONE;
00150 IF J≤35 THEN BEGIN GVAL[L]←(1 LSH (35-J)); GFLAG[L]←2; DONE END
00160 ELSE OUTSTR("Gate not identified"&CRLF); END;
00170 END; END "PHIN";
00180
00190 OUTSTR("Two input parameters are to be specified"&crlf);
00200 FOR L←0 STEP 1 UNTIL 1 DO BEGIN
00210 WHILE TRUE DO BEGIN
00220 IN[L]←STRIN("Type input name = "); J←CVASC(IN[L]);
00230 FOR P←0 STEP 1 UNTIL INSIZ-1 DO IF J=INNAM[P] THEN DONE;
00240 IF P<INSIZ THEN BEGIN IX[L]←P;DONE END
00250 ELSE OUTSTR("Not found"&CRLF); END; END; M1←IX[0]; N1←IX[1];
00260
00270 OUTSTR("Type A if averages for each phone are wanted, otherwise CR only ");
00280 OPT2←INCHWL;
00290 IF OPT2="A" THEN OUTSTR(CRLF&"Average figures will be tabulated."&CRLF);
00300 FOR L←0 STEP 1 UNTIL 3 DO NUMLS[L]←NUML[L]←MS[L]←NS[L]←0;
00310 CLOSE(CHAN2); OPEN(CHAN2,"DSK",0,0,'10,0,0,0);
00320 SPONAM←GATENA[0]&".HIS";
00330 ENTER(CHAN2,SPONAM,0);
00340 OUT(CHAN2,"The following files were used "&CRLF);
00350 setformat(1,0);
00360 ⊂ **** MAIN ROUTINE STARTS HERE****;
00370 WHILE TRUE DO BEGIN
00380 STRT: CLOSE(CHAN6);
00390 IF OPT1≠"Y" THEN
00400 IF (TFILEI←STRIN("Data file FFT/LPC ("&FILEI&")="))≠"" THEN
00410 FILEI←TFILEI ELSE OPT1←"Y";
00420 IF FILEI="E" THEN DONE;
00430 IF OPT1="Y" THEN BEGIN FILEC←FILEC+1; SETFORMAT(1,0);
00440 IF FILEC>7 THEN DONE;
00450 FILEI←"SEG"&CVS(FILEC)&".T0X"; END;
00460
00470 CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00480 LOOKIN(CHAN4,FILEI); EOF←SEGC←SEGCNT←0;
00490 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
00500 IF LFILE[21]=0 THEN DONE; ⊂ No more hints;
00510 HINDEX←21; HCOUNT←HINCNT←0;
00520 SEGTOT←(LFILE[0])*3%128; RATE←LFILE[2];
00530 OUTSTR(" "&FILEI);
00540 OUT(CHAN2," "&FILEI);
00550
00560
00570
00580 WHILE EOF=0 DO BEGIN "DATAIN"
00590 ARRYIN(CHAN4,DATBUF[0],BUFSIZ); ⊂ Get data;
00600 BPT←POINT(6,DATBUF[0],-1);
00610
00620 FOR Q←1 STEP 1 UNTIL BUFSIZ%4 DO BEGIN
00630 SEGC←SEGC+1;
00640 IF SEGC>SEGTOT THEN DONE;
00650
00660 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
00670 I←HEADER;
00680 FOR L←0 STEP 1 UNTIL 3 DO BEGIN "XL"
00690 WHILE TRUE DO BEGIN
00700 IF GFLAG[L]=0 THEN DONE;
00710 IF GFLAG[L]=1 THEN IF I≠GVAL[L] THEN DONE;
00720 IF GFLAG[L]=2 THEN BEGIN
00730 FOR J←0 STEP 1 UNTIL 63 DO IF I=PHLIST[J] THEN DONE;
00740 IF J≥64 THEN DONE;
00750 IF (HLIST[J] LAND GVAL[L])=0 THEN DONE; END;
00760 M←INDAT[M1]; N←INDAT[N1];
00770 NUMLS[L]←NUMLS[L]+1;
00780 IF OPT2="A" THEN BEGIN
00790 MS[L]←MS[L]+M; NS[L]←NS[L]+N;
00800 NUML[L]←NUML[L]+1;
00810 IF HCOUNT>0 THEN DONE;
00820 M←((MS[L]*2%NUML[L])+1) LSH -1;
00830 N←((NS[L]*2%NUML[L])+1) LSH -1;
00840 END;
00850 COUNT[M,N]←COUNT[M,N]+BIT[L];
00860 SUMM[M,L]←SUMM[M,L]+1; SUMN[N,L]←SUMN[N,L]+1;
00870 DONE END;
00880 MTOT[L]←NTOT[L]←0;
00890 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
00900 MTOT[L]←MTOT[L]+SUMM[J,L]; NTOT[L]←NTOT[L]+SUMN[J,L]; END;
00910
00920 END "XL";
00930
00940 END;
00950 IF SEGC>SEGTOT THEN DONE;
00960 END "DATAIN"; CLOSE(CHAN4); END; close(chan4);
00970 OUTSTR(CRLF&"Last input data has been read."&CRLF);
00980 OUT(CHAN2,CRLF&LF);
00990
01000 FOR L←0 STEP 1 UNTIL 3 DO BEGIN "PXL"
01010 IF GFLAG[L]=0 THEN CONTINUE "PXL";IF MTOT[L]=0 THEN BEGIN
01020 OUT(CHAN2,"No data for Phonette or Feature "&GATENA[L]&CRLF&LF);
01030 outstr("No data for Phone or Feature "&GATENA[L]&CRLF);
01040 CONTINUE "PXL"; END;
01050 OUTSTR("Beginning cluster plot for "&GATENA[L]&CRLF);
01060 IF GFLAG[L]=2 THEN
01070 OUT(CHAN2,CRLF&"Cluster plot for feature ")
01080 ELSE OUT(CHAN2,CRLF&"Cluster plot for Phonette ");
01090 OUT(CHAN2,GATENA[L]&" with inputs "&IN[0]&" and "&IN[1]&"."&TB&DATIME&CRLF);
01100 OUT(CHAN2,TB&CVS(MTOT[L])&" entries based on "&CVS(NUMLS[L])&" items."&LF&CRLF);
01110 IF MTOT[L]≠NTOT[L] THEN OUTSTR("ERROR IN COUNTS"&CRLF);
01120 TOP;
01130 TOT←TOTD←0;
01140 OUT(CHAN2,"+ Sums Decile"&CRLF);
01150 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
01160 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
01170 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
01180 Q←(COUNT[M,N] LSH ((L*9)-27)) LAND '777;
01190
01200 IF Q=0 THEN OUT(CHAN2," ") ELSE
01210 IF Q>9 THEN OUT(CHAN2,"&") ELSE
01220 OUT(CHAN2,CVS(Q));
01230 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
01240 SETFORMAT(4,0); OUT(CHAN2,"|"&CVS(SUMM[M,L]));
01250 TOT←TOT+SUMM[M,L]*10;
01260 IF TOT≥MTOT[L] THEN BEGIN WHILE TOT≥MTOT[L] DO BEGIN
01270 TOT←TOT-MTOT[L]; TOTD←TOTD+1; END;
01280 IF TOTD<10 THEN OUT(CHAN2," _"&CVS(TOTD)); END;
01290 OUT(CHAN2,CRLF0);
01300 IF M≠63 THEN IF (M MOD 8)=7 THEN OUT(CHAN2,CRLF0);
01310
01320 OUT(CHAN2," ");
01330 END;
01340 BOTTOM;
01350 SETFORMAT(3,0); OUT(CHAN2,"Sums →"&TB&"|");
01360 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
01370 OUT(CHAN2,CVS(SUMN[J,L])[1 TO 1]);
01380 IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
01390 OUT(CHAN2,CRLF0&TB&"|");
01400 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
01410 OUT(CHAN2,CVS(SUMN[J,L])[2 TO 2]);
01420 IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
01430 OUT(CHAN2,CRLF0&TB&"|");
01440 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
01450 OUT(CHAN2,CVS(SUMN[J,L])[3 TO 3]);
01460 IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
01470 SETFORMAT(1,0);
01480 TOT←TOTD←0; OUT(CHAN2,CRLF&LF&"Decile"&TB&" ");
01490 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
01500 TOT←TOT+SUMN[J,L]*10;
01510 IF TOT≥NTOT[L] THEN BEGIN WHILE TOT≥NTOT[L] DO BEGIN
01520 TOT←TOT-NTOT[L]; TOTD←TOTD+1; END;
01530 IF TOTD<10 THEN OUT(CHAN2,CVS(TOTD)); END ELSE OUT(CHAN2," ");
01540 IF (J MOD 8) =7 THEN OUT(CHAN2," "); END;
01550 OUT(CHAN2,FF); END "PXL";
01560 OUTSTR("Feature plots are complete."&CRLF);
01570
01580
01590 OUT(CHAN2,CRLF&
01600 "Confusion plot (overlap of features) with inputs "&
01610 IN[0]&" and "&IN[1]&"."&TB&DATIME&crlf&LF&TB&
01620 "Key: 1="&GATENA[0]&" and "&GATENA[1]&CRLF&TB&" "&
01630 "2="&GATENA[0]&" and "&GATENA[2]&CRLF&TB&" "&
01640 "3="&GATENA[0]&" and "&GATENA[3]&CRLF&TB&" "&
01650 "4="&GATENA[1]&" and "&GATENA[2]&CRLF&TB&" "&
01660 "5="&GATENA[1]&" and "&GATENA[3]&CRLF&TB&" "&
01670 "6="&GATENA[2]&" and "&GATENA[3]&CRLF&TB&" ");
01680 OUT(CHAN2,
01690 "A="&GATENA[0]&", "&GATENA[1]&" and "&GATENA[2]&CRLF&TB&" "&
01700 "B="&GATENA[0]&", "&GATENA[1]&" and "&GATENA[3]&CRLF&TB&" "&
01710 "C="&GATENA[0]&", "&GATENA[2]&" and "&GATENA[3]&CRLF&TB&" "&
01720 "D="&GATENA[1]&", "&GATENA[2]&" and "&GATENA[3]&CRLF&TB&" "&
01730 "&= All four of the features"&CRLF&LF);
01740
01750 TOP;
01760 OUT(CHAN2,"+"&CRLF);
01770 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
01780 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
01790 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
01800 Q←COUNT[M,N]; P←0;
01810
01820 IF (Q LAND '000777777777)=0 THEN P←1 ELSE
01830 IF (Q LAND '777000777777)=0 THEN P←1 ELSE
01840 IF (Q LAND '777777000777)=0 THEN P←1 ELSE
01850 IF (Q LAND '777777777000)=0 THEN P←1;
01860 IF P=1 THEN OUT(CHAN2," ") ELSE
01870 FOR L←0 STEP 1 UNTIL 10 DO
01880 IF (Q LAND MASK[L])=0 THEN BEGIN
01890 OUT(CHAN2,CVXSTR(SYMBOL[L])[6 TO 6]); DONE END;
01900 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
01910 OUT(CHAN2,"|"&CRLF0);
01920 IF M≠63 THEN IF (M MOD 8)=7 THEN OUT(CHAN2,CRLF0);
01930 END;
01940 BOTTOM;
01950 OUT(CHAN2,FF);
01960 OUTSTR("The confusion plot is done."&CRLF);
01970
01980
01990 OUT(CHAN2,CRLF&"Composite plot showing feature dominance with inputs "
02000 &IN[0]&" and "&IN[1]&"."&TB&DATIME&CRLF&LF
02010 &TB&"Key: 1="&GATENA[0]&CRLF
02020 &TB&" 2="&GATENA[1]&CRLF
02030 &TB&" 3="&GATENA[2]&CRLF
02040 &TB&" 4="&GATENA[3]&CRLF&LF);
02050 TOP;
02060 OUT(CHAN2,"+"&CRLF);
02070 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
02080 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
02090 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
02100 J←COUNT[M,N];
02110 M1←(J LSH -27) LAND '777;
02120 M2←(J LSH -18) LAND '777;
02130 M3←(J LSH -9) LAND '777;
02140 M4←J LAND '777;
02150 Q←0;
02160 IF M1=M2=M3=M4 THEN OUT(CHAN2," ") ELSE BEGIN
02170 IF M1>M2 THEN IF M1>M3 THEN BEGIN
02180 IF M1>M4 THEN Q←1 ELSE Q←4; END ELSE BEGIN
02190 IF M3>M4 THEN Q←3 ELSE Q←4; END ELSE
02200 IF M2≥M1 THEN IF M2>M3 THEN BEGIN
02210 IF M2>M4 THEN Q←2 ELSE Q←4 END ELSE BEGIN
02220 IF M3>M4 THEN Q←3 ELSE Q←4; END;
02230 IF Q=1 THEN BEGIN OUT(CHAN2,"1"); M1←0; END ELSE
02240 IF Q=2 THEN BEGIN OUT(CHAN2,"2"); M2←0; END ELSE
02250 IF Q=3 THEN BEGIN OUT(CHAN2,"3"); M3←0; END ELSE
02260 IF Q=4 THEN BEGIN OUT(CHAN2,"4"); M4←0; END;
02270 COUNT[M,N]←(M1 LSH 27)+(M2 LSH 18)+(M3 LSH 9)+M4;
02280 ⊂ This removes the dominant data from the array
02290 so that submerged data can be shown;
02300 END;
02310 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
02320 OUT(CHAN2,"|"&CRLF0);
02330 IF M≠63 THEN IF (M MOD 8)=7 THEN OUT(CHAN2,CRLF0);
02340 END;
02350 BOTTOM;
02360 OUT(CHAN2,FF);
02370 OUTSTR("The feature dominance plot has been produced."&CRLF);
02380
02390
02400 FOR L←0 STEP 1 UNTIL 3 DO IF GFLAG[L]≠0 THEN BEGIN "PSXL"
02410 OUT(CHAN2,CRLF&"Submerged data for feature "&GATENA[L]&" with inputs "&
02420 IN[0]&" and "&IN[1]&"."&TB&DATIME&CRLF&LF);
02430 out(chan2,tb&"Features considered are "&GATENA[0]&", "&GATENA[1]&
02440 ", "&GATENA[2]&" and "&GATENA[3]&"."&CRLF&LF);
02450 TOP;
02460 OUT(CHAN2,CRLF);
02470 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
02480 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
02490 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
02500 Q←(COUNT[M,N] LSH ((L*9)-27)) LAND '777;
02510
02520 IF Q=0 THEN OUT(CHAN2," ") ELSE
02530 IF Q>9 THEN OUT(CHAN2,"&") ELSE
02540 OUT(CHAN2,CVS(Q));
02550 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
02560 SETFORMAT(4,0); OUT(CHAN2,"|"&CRLF0);
02570 IF M≠63 THEN IF (M MOD 8)=7 THEN OUT(CHAN2,CRLF0);
02580 END;
02590 BOTTOM;
02600 OUT(CHAN2,FF); END "PSXL";
02610 CLOSE(CHAN2);
02620 OUTSTR("Submerged data plot finished and the output will be spooled."&CRLF);
02630 SPOOL(SPONAM,GETCHAN,0);
02640
02650 END "CLUSTER";